home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / color.swg / 0021_Color Codes.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-05-26  |  2.5 KB  |  75 lines
  1. {
  2.  ├─>I would like to implement color codes into my on-line doors.  You know
  3.  ├─>the type that Wildcat or PCB have.  The @ codes.  Does anyone have a
  4.  ├─>routine that would (I assume) read in a file bite by bite and when it
  5.  ├─>comes across the @ char it would read the next 3 bits and determine what
  6.  ├─>action to take?
  7.  
  8. Hi Larry! Sure do have one for 'ya!
  9.  
  10. Try this one out for size. It can be optimized to be smaller, but as an
  11. example, this one works for sure! You'll have to incorporate it into your
  12. code to dump out to the modem (no problem I hope!)
  13.  
  14. Give this a try: }
  15.  
  16.   type
  17.     string255=string[255];
  18.  
  19.   procedure outgoing(stream:string255; ret:integer);
  20.   var
  21.     _retval:integer;
  22.     out,out1:string[5];
  23.   begin
  24.     for _retval:=1 to length(stream) do
  25.       begin
  26.         out:=copy(stream,_retval,1);
  27.         case out[1] of
  28.           '@':begin { COLOR CODE    ---> @X1F or other }
  29.                 out1:=copy(stream,_retval+2,1);
  30.                 case out1[1] of
  31.                   '0':textbackground(0);
  32.                   '1':textbackground(1);
  33.                   '2':textbackground(2);
  34.                   '3':textbackground(3);
  35.                   '4':textbackground(4);
  36.                   '5':textbackground(5);
  37.                   '6':textbackground(6);
  38.                   '7':textbackground(7);
  39.                   '8':textbackground(8);
  40.                   '9':textbackground(9);
  41.                   'A':textbackground(10);
  42.                   'B':textbackground(11);
  43.                   'C':textbackground(12);
  44.                   'D':textbackground(13);
  45.                   'E':textbackground(14);
  46.                   'F':textbackground(15);
  47.                 end;
  48.                 out1:=copy(stream,_retval+3,1);
  49.                 case out1[1] of
  50.                   '0':textcolor(0);
  51.                   '1':textcolor(1);
  52.                   '2':textcolor(2);
  53.                   '3':textcolor(3);
  54.                   '4':textcolor(4);
  55.                   '5':textcolor(5);
  56.                   '6':textcolor(6);
  57.                   '7':textcolor(7);
  58.                   '8':textcolor(8);
  59.                   '9':textcolor(9);
  60.                   'A':textcolor(10);
  61.                   'B':textcolor(11);
  62.                   'C':textcolor(12);
  63.                   'D':textcolor(13);
  64.                   'E':textcolor(14);
  65.                   'F':textcolor(15);
  66.                 end;
  67.                 _retval:=_retval+3;
  68.               end;
  69.           else write(out[1]);
  70.         end;
  71.       end;
  72.     if ret=2 then writeln;
  73.   end;
  74.  
  75.